home *** CD-ROM | disk | FTP | other *** search
/ A.C.E. 2 / ACE CD 2.iso / FILES / UTILS / AMOS3.DMS / AMOS3.adf / Extensions / Compact.s next >
Text File  |  1978-10-10  |  16KB  |  720 lines
  1.  
  2.         Include    "Equ.s"
  3. GetEc        equ $18
  4. AdOrBank    equ $1C
  5. EffBank        equ $20
  6.     
  7. ******************************************************************
  8. *     **  *    * **** ****    ***    **  **** ***  ***
  9. *     *  * **  ** *  * *       *  *  *  * *     *  *
  10. *     **** * ** * *  * ****    ****  **** ****  *  *
  11. *     *  * *    * *  *    *    *   * *  *    *  *  *  
  12. *     *  * *    * **** ****    ****  *  * **** ***  ***
  13. ******************************************************************
  14. *    
  15. *    AMOS SCREEN COMPACTOR EXTENSION
  16. *    
  17. *    By Francois Lionet
  18. *
  19. *    AMOS (c) 1990 Mandarin / Jawx
  20. *
  21. ******************************************************************
  22. *    This source code is public domain. You can freely copy,
  23. * modify, distribute it. Experiment with it, and have fun!
  24. ******************************************************************
  25. *
  26. *    ABOUT THIS PROGRAM
  27. *
  28. *    This extension obeys to the same rules than the music extension.
  29. * Please refer to it for more information on AMOS interface.
  30. *    It uses the same compaction process than STOS screen compactor,
  31. * and have some nice features like automatic screen opening. For more
  32. * informations on AMOS internal libraries functions, please join the
  33. * AMOS club!
  34. *
  35. ******************************************************************
  36.  
  37.  
  38. ******************************************************************
  39. *    AMOS INTERFACE
  40.  
  41. *******    COLD START
  42.     lea    PacAdr(pc),a1
  43.     move.l    a0,(a1)            * Address of BRANCH TABLE
  44.     moveq    #0,d2            * No check bank
  45.     lea    Tk(pc),a0        * Address of TOKEN TABLE
  46.     lea    PacWel(pc),a1        * Address of WELCOME MESSAGE
  47.     lea    PacDef(pc),a2        * Address of SCREEN RESET
  48.     lea    PacEnd(pc),a3        * Address of QUIT
  49.     moveq    #1,d1            * Returns NUMBER OF EXTENSION
  50.     moveq    #0,d0            * NO ERRORS
  51.     rts
  52.  
  53. ******* SCREEN RESET
  54. PacDef:    rts
  55.  
  56. ******* QUIT
  57. PacEnd:    rts
  58.  
  59. ******* Call normal error messages
  60. Bkares    moveq    #35,d0
  61.     bra.s    IError
  62. OOMem    moveq    #24,d0            
  63.     bra.s    IError
  64. IFonc:    moveq    #23,d0            
  65. IError:    move.l    PacAdr(pc),a0        
  66.     jmp    4(a0)
  67. ******* Call customized error messages
  68. Noscr    moveq    #1,d0
  69.     bra.s    Custom
  70. Nopac    moveq    #0,d0
  71. Custom:    moveq    #0,d1            * Error can be trapped
  72.     lea    PacErr(pc),a0        * Your list
  73.     move.l    PacAdr(pc),a1
  74.     jmp    8(a1)
  75. ******* Debugging
  76. IBug:    move.l    PacAdr(pc),a0
  77.     jmp    (a0)
  78.  
  79. *******************************************************************
  80. *    PACK Screen,Bank#
  81. *    PACK Screen,Bank#,X1,Y1 TO X2,Y2
  82. Pack2    clr.l    -(a3)            * Y1
  83.     clr.l    -(a3)            * X1
  84.     move.l    #10000,-(a3)        * Y2
  85.     move.l    (a3),-(a3)        * X2
  86. Pack6    bsr    PacPar
  87.     bsr    GetSize
  88.     bsr    ResBank
  89.     bsr    Pack
  90.     rts
  91.     
  92. *******************************************************************
  93. *    SPACK Screen,Bank#[,X1,Y1 TO X2,Y2]
  94. SPack2    clr.l    -(a3)
  95.     clr.l    -(a3)
  96.     move.l    #10000,-(a3)
  97.     move.l    (a3),-(a3)
  98. SPack6    bsr    PacPar
  99.     bsr    GetSize
  100.     add.l    #PsLong,d0
  101.     bsr    ResBank
  102. * Screen definition header
  103.     move.l    #SCCode,(a1)
  104.     move.w    EcTx(a0),PsTx(a1)
  105.     move.w    EcTy(a0),PsTy(a1)
  106.     move.w    EcNbCol(a0),PsNbCol(a1)
  107.     move.w    EcNPlan(a0),PsNPlan(a1)
  108.     move.w    EcCon0(a0),PsCon0(a1)
  109.     move.w    EcAWX(a0),PsAWX(a1)
  110.     move.w    EcAWY(a0),PsAWY(a1)
  111.     move.w    EcAWTX(a0),PsAWTX(a1)
  112.     move.w    EcAWTY(a0),PsAWTY(a1)
  113.     move.w    EcAVX(a0),PsAVX(a1)
  114.     move.w    EcAVY(a0),PsAVY(a1)
  115.     movem.l    a0/a1,-(sp)
  116.     moveq    #31,d0
  117.     lea    EcPal(a0),a0
  118.     lea    PsPal(a1),a1
  119. SPac1    move.w    (a0)+,(a1)+
  120.     dbra    d0,SPac1
  121.     movem.l    (sp)+,a0/a1
  122.     lea    PsLong(a1),a1
  123. * Finish packing!
  124.     bsr    Pack
  125.     rts
  126.  
  127. ******* Reserves memory bank
  128. ResBank    movem.l    a0/d1,-(sp)
  129.     addq.l    #8,d0
  130.     move.l    d0,d1
  131.     SyCall    SyFast
  132.     beq    OOMem
  133.     move.l    d0,(a1)+
  134.     bset    #31,d1
  135.     move.l    d1,(a1)+
  136.     move.l    d0,a1
  137.     lea    BkPac(pc),a0
  138.     move.l    (a0)+,(a1)+
  139.     move.l    (a0)+,(a1)+
  140.     movem.l    (sp)+,a0/d1
  141.     rts
  142.  
  143. ******* Unpile parameters
  144. *    Screen-> a0/a2
  145. *    Bank  -> a1
  146. PacPar    move.l    (a3)+,d5
  147.     move.l    (a3)+,d4
  148.     move.l    (a3)+,d3
  149.     move.l    (a3)+,d2
  150.     lsr.w    #3,d4
  151.     lsr.w    #3,d2
  152. * Screen
  153.     move.l    4(a3),d1
  154.     move.l    PacAdr(pc),a0
  155.     jsr    GetEc(a0)
  156.     move.l    d0,a2
  157.     cmp.w    EcTLigne(a0),d4
  158.     bls.s    PacP1
  159.     move.w    EcTLigne(a0),d4
  160. PacP1    cmp.w    EcTy(a0),d5
  161.     bls.s    PacP2
  162.     move.w    EcTy(a0),d5
  163. PacP2    sub.w    d2,d4
  164.     ble    IFonc
  165.     sub.w    d3,d5
  166.     ble    IFonc
  167. * Memory bank
  168.     move.l    d3,-(sp)
  169.     move.l    (a3)+,d3
  170.     subq.l    #1,d3
  171.     cmp.l    #16,d3
  172.     bcc    IFonc
  173.     move.l    PacAdr(pc),a1        * Erase bank
  174.     jsr    EffBank(a1)
  175.     lsl.w    #3,d3            * Address of pointer
  176.     move.l    ABanks(a5),a1
  177.     add.w    d3,a1
  178.     tst.l    (a1)
  179.     bne    IFonc
  180.     move.l    (sp)+,d3
  181.     addq.l    #4,a3
  182.     rts
  183.     
  184. ***************************************************************************
  185. * 
  186. *       BITMAP COMPACTOR
  187. *                       A0: Origin screen datas
  188. *                       A1: Destination zone
  189. *            A2: Origin screen bitmap
  190. *                       D2: DX in BYTES
  191. *                       D3: DY in LINES
  192. *                       D4: TX in BYTES
  193. *                       D5: TY in LINES
  194. *
  195. ***************************************************************************
  196.  
  197. ***************************************************************************
  198. *     ESTIMATE THE SIZE OF A PICTURE
  199.  
  200. ******* Makes differents tries
  201. *    And finds the best square size in D1
  202. GetSize    movem.l    a1-a3,-(sp)
  203.     lea    TSize(pc),a3
  204.     move.l    Buffer(a5),a1
  205.     moveq    #0,d7
  206.     move.w    d5,d7
  207.     clr.w    -(sp)
  208.     move.l    #$10000000,-(sp)
  209. GSize1    move.l    d7,d5
  210.     move.w    (a3)+,d1
  211.     beq.s    GSize2
  212.     divu    d1,d5
  213.     swap    d5
  214.     tst.w    d5
  215.     bne.s    GSize1
  216.     swap    d5
  217.     bsr    PacSize
  218.     cmp.l    (sp),d0
  219.     bcc.s    GSize1
  220.     move.l    d0,(sp)
  221.     move.w    d1,4(sp)
  222.     bra.s    GSize1
  223. GSize2    move.l    (sp)+,d0
  224.     move.w    (sp)+,d1
  225.     move.l    d7,d5
  226.     divu    d1,d5
  227.     movem.l    (sp)+,a1-a3
  228.     rts
  229.  
  230. ******* Simulate a packing
  231. PacSize    movem.l    d1-d7/a0-a6,-(sp)
  232. * Fake data zone
  233.         move.w     d2,Pkdx(a1)
  234.         move.w     d3,Pkdy(a1)  
  235.         move.w     d4,Pktx(a1)  
  236.         move.w     d5,Pkty(a1)   
  237.         move.w     d1,Pktcar(a1)  
  238. * Reserve intermediate table space
  239.     move.w    d1,d0
  240.     mulu    d4,d0
  241.     mulu    d5,d0
  242.     mulu    EcNPlan(a0),d0
  243.     lsr.l    #3,d0
  244.     addq.l    #2,d0
  245.     move.l    d0,-(sp)
  246.     move.l    a0,-(sp)
  247.     SyCall    SyFast
  248.     beq    OoMem
  249.     move.l    (sp)+,a0
  250.     move.l    d0,a6
  251.     move.l    d0,-(sp)
  252. * Prepare registers
  253.         move.l    a2,a4                ;a4--> picture address
  254.         lea     PkDatas1(a1),a5            ;a5--> main datas
  255.     move.w    EcTLigne(a0),d7
  256.     move.w    d7,d5
  257.     mulu    d1,d5            ;d5--> SY line of square
  258.         move.w     Pkdy(a1),d3
  259.         mulu     d7,d3
  260.         move.w     Pkdx(a1),d0
  261.     ext.l    d0
  262.     add.l    d0,d3
  263.     move.w    EcNPlan(a0),-(sp)
  264. * Main packing
  265.         moveq     #7,d1                  * Bit pointer
  266.     moveq    #0,d0
  267. Iplan:  move.l     (a4)+,a3
  268.     add.l    d3,a3
  269.         move.w     Pkty(a1),d6
  270.     subq.w    #1,d6
  271. Iligne: move.l     a3,a2
  272.     move.w    Pktx(a1),d4
  273.     subq.w    #1,d4
  274. Icarre: move.l     a2,a0
  275.         move.w     Pktcar(a1),d2
  276.     subq.w    #1,d2
  277. Ioct0:     cmp.b     (a0),d0             * Compactage d'un carre
  278.         beq.s     Ioct1
  279.     move.b    (a0),d0
  280.         addq.l     #1,a5
  281.         bset     d1,(a6)
  282. Ioct1:  dbra     d1,Ioct2
  283.         moveq     #7,d1
  284.         addq.l     #1,a6
  285.     clr.b    (a6)
  286. Ioct2:  add.w     d7,a0
  287.         dbra     d2,Ioct0
  288.         addq.l    #1,a2    
  289.         dbra     d4,Icarre    
  290.     add.l    d5,a3    
  291.         dbra     d6,Iligne    
  292.     subq.w    #1,(sp)
  293.     bne.s    IPlan
  294.     addq.l    #2,sp
  295.     addq.l    #1,a5
  296. * Packing of first pointers table
  297.     move.l    a5,a6
  298.     move.l    4(sp),d2
  299.     move.l    d2,d0
  300.     subq.w    #1,d2
  301.     lsr.w    #3,d0
  302.     addq.w    #2,d0
  303.     add.w    d0,a5
  304.     move.l    (sp),a0
  305.     moveq    #0,d0
  306.         moveq     #7,d1
  307. Icomp2  cmp.b     (a0)+,d0
  308.         beq.s     Icomp2a
  309.     move.b    -1(a0),d0
  310.         addq.l     #1,a5
  311. Icomp2a dbra    d2,Icomp2
  312. * Final size (EVEN!)
  313.     move.l    a5,d2
  314.     sub.l    a1,d2
  315.     addq.l    #3,d2
  316.     and.l    #$FFFFFFFE,d2
  317. * Free intermediate memory
  318.     move.l    (sp)+,a1
  319.     move.l    (sp)+,d0
  320.     SyCall    SyFree
  321. * Finished!
  322.     move.l    d2,d0
  323.     movem.l    (sp)+,d1-d7/a0-a6
  324.     rts
  325.  
  326. ***********************************************************
  327. *    REAL PACKING!!!
  328. Pack:
  329.  
  330. * Header of the packed bitmap
  331.     movem.l    d1-d7/a0-a6,-(sp)
  332.  
  333. * Packed bitmap header
  334.         move.l     #BMCode,PkCode(a1)
  335.         move.w     d2,Pkdx(a1)
  336.         move.w     d3,Pkdy(a1)  
  337.         move.w     d4,Pktx(a1)  
  338.         move.w     d5,Pkty(a1)   
  339.         move.w     d1,Pktcar(a1)  
  340.     move.w    EcNPlan(a0),PkNPlan(a1)
  341.  
  342. * Reserve intermediate table space
  343.     move.w    d1,d0
  344.     mulu    d4,d0
  345.     mulu    d5,d0
  346.     mulu    EcNPlan(a0),d0
  347.     lsr.l    #3,d0
  348.     addq.l    #2,d0
  349.     move.l    d0,-(sp)
  350.     move.l    a0,-(sp)
  351.     SyCall    SyFast
  352.     beq    OoMem
  353.     move.l    (sp)+,a0
  354.     move.l    d0,a6
  355.     move.l    d0,-(sp)
  356.  
  357. * Prepare registers
  358.         move.l    a2,a4                ;a4--> picture address
  359.         lea     PkDatas1(a1),a5            ;a5--> main datas
  360.     move.w    EcTLigne(a0),d7
  361.     move.w    d7,d5
  362.     mulu    d1,d5            ;d5--> SY line of square
  363.         move.w     Pkdy(a1),d3
  364.         mulu     d7,d3
  365.         move.w     Pkdx(a1),d0
  366.     lsr.w    #3,d0
  367.     ext.l    d0
  368.     add.l    d0,d3
  369.     move.w    EcNPlan(a0),-(sp)
  370.  
  371. * Main packing
  372.         moveq     #7,d1                  * Bit pointer
  373.     moveq    #0,d0
  374.         clr.b     (a5)                  * First byte to zero
  375.         clr.b     (a6)              
  376. plan:   move.l     (a4)+,a3
  377.     add.l    d3,a3
  378.         move.w     Pkty(a1),d6
  379.     subq.w    #1,d6
  380. ligne:  move.l     a3,a2
  381.     move.w    Pktx(a1),d4
  382.     subq.w    #1,d4
  383. carre:  move.l     a2,a0
  384.         move.w     Pktcar(a1),d2
  385.     subq.w    #1,d2
  386. oct0:     cmp.b     (a0),d0             * Compactage d'un carre
  387.         beq.s     oct1
  388.     move.b    (a0),d0
  389.         addq.l     #1,a5
  390.         move.b     d0,(a5)
  391.         bset     d1,(a6)
  392. oct1:   dbra     d1,oct2
  393.         moveq     #7,d1
  394.         addq.l     #1,a6
  395.         clr.b     (a6)
  396. oct2:   add.w     d7,a0
  397.         dbra     d2,oct0
  398.         addq.l    #1,a2            * Carre suivant en X
  399.         dbra     d4,carre    
  400.     add.l    d5,a3            * Ligne suivante
  401.         dbra     d6,ligne    
  402.     subq.w    #1,(sp)            * Plan couleur suivant
  403.     bne.s    Plan
  404.     addq.l    #2,sp
  405.     addq.l    #1,a5
  406.  
  407. ; Packing of first pointers table
  408.     move.l    a5,d0
  409.     sub.l    a1,d0
  410.     move.l    d0,PkPoint2(a1)
  411.     move.l    a5,a6
  412.     move.l    4(sp),d0
  413.     move.l    d0,d2
  414.     subq.w    #1,d2
  415.     lsr.w    #3,d0
  416.     addq.w    #2,d0
  417.     add.w    d0,a5
  418.     move.l    a5,d0
  419.     sub.l    a1,d0
  420.     move.l    d0,PkDatas2(a1)
  421.     move.l    (sp),a0
  422.     moveq    #0,d0
  423.         moveq     #7,d1
  424.         clr.b     (a5)
  425.         clr.b     (a6)
  426. comp2:  cmp.b     (a0)+,d0
  427.         beq.s     comp2a
  428.     move.b    -1(a0),d0
  429.         addq.l     #1,a5
  430.         move.b     d0,(a5)
  431.         bset     d1,(a6)
  432. comp2a: dbra     d1,comp2b
  433.         moveq     #7,d1
  434.         addq.l     #1,a6
  435.         clr.b     (a6)
  436. comp2b: dbra    d2,Comp2
  437.  
  438. * Free intermediate memory
  439.     move.l    (sp)+,a1
  440.     move.l    (sp)+,d0
  441.     SyCall    SyFree
  442.     movem.l    (sp)+,d1-d7/a0-a6
  443.     rts
  444.  
  445. *************************************************************************
  446. *    UNPACK Bank#         -> To current screen
  447. *    UNPACK Bank#,X,Y    -> To current screen
  448. UPack1    move.l    ScOnAd(a5),d0
  449.     beq    IFonc
  450.     move.l    d0,a1
  451.     moveq    #-1,d1
  452.     moveq    #-1,d2
  453.     bra.s    UPack
  454. UPack3    move.l    ScOnAd(a5),d0
  455.     beq    IFonc
  456.     move.l    d0,a1
  457.     move.l    (a3)+,d2
  458.     move.l    (a3)+,d1
  459.     lsr.l    #3,d1
  460. UPack    movem.l    d1/d2/a1/a2,-(sp)
  461.     move.l    PacAdr(pc),a0
  462.     jsr    AdOrBank(a0)
  463.     movem.l    (sp)+,d1/d2/a1/a2
  464.     move.l    d3,a0
  465. * Autoback 
  466.     tst.w    EcAuto(a1)        * Is screen autobacked?
  467.     beq    UnPack            * NOPE! Do simple unpack
  468.     movem.l    d0-d7/a0-a2,-(sp)    * YEP! First step
  469.     EcCall    AutoBack1
  470.     movem.l    (sp),d0-d7/a0-a2
  471.     btst    #BitDble,EcFlags(a1)    * DOUBLE BUFFER?
  472.     beq.s    ABPac1
  473.     bsr    UnPack
  474.     EcCall    AutoBack2        * Second step
  475.     movem.l    (sp),d0-d7/a0-a2
  476.     bsr    UnPack
  477.     EcCall    AutoBack3        * Third step
  478.     bra.s    ABPac2
  479. ABPac1    bsr    UnPack            * SINGLE BUFFER autobacked
  480.     EcCall    AutoBack4
  481. ABPac2    movem.l    (sp)+,d0-d7/a0-a2
  482.     rts
  483.  
  484. *************************************************************************
  485. *    UNPACK Bank# TO screen    -> Creates/Erases screen!
  486. UPack2    move.l    (a3)+,d1
  487.     cmp.l    #8,d1
  488.     bcc    IFonc
  489. * Creates new screen
  490.     move.l    d1,-(sp)
  491.     move.l    PacAdr(pc),a0
  492.     jsr    AdOrBank(a0)
  493.     move.l    (sp)+,d1
  494.     move.l    d3,a0
  495.     cmp.l    #SCCode,PsCode(a0)
  496.     bne    NoScr
  497.     moveq    #0,d2
  498.     moveq    #0,d3
  499.     moveq    #0,d4
  500.     moveq    #0,d5
  501.     move.w    PsTx(a0),d2
  502.     move.w    PsTy(a0),d3
  503.     move.w    PsNPlan(a0),d4
  504.     move.w    PsCon0(a0),d5
  505.     move.w    PsNbCol(a0),d6
  506.     lea    PsPal(a0),a1
  507.     move.l    a0,-(sp)
  508.     EcCall    Cree
  509.     bne    OOMem
  510.     move.l    a0,a1
  511.     move.l    (sp)+,a0
  512.     move.l    a1,ScOnAd(a5)
  513.     move.w    EcNumber(a1),ScOn(a5)
  514.     addq.w    #1,ScOn(a5)
  515. * Change View/Offset
  516.     move.w    PsAWX(a0),EcAWX(a1)
  517.     move.w    PsAWY(a0),EcAWY(a1)
  518.     move.w    PsAWTx(a0),EcAWTx(a1)
  519.     move.w    PsAWTy(a0),EcAWTy(a1)
  520.     move.w    PsAVX(a0),EcAVX(a1)
  521.     move.w    PsAVY(a0),EcAVY(a1)
  522.     move.b    #%110,EcAW(a1)
  523.     move.b    #%110,EcAWT(a1)
  524.     move.b    #%110,EcAV(a1)
  525. * Unpack!
  526.     lea    PsLong(a0),a0
  527.     moveq    #0,d1
  528.     moveq    #0,d2
  529.     bsr    UnPack
  530.     rts
  531.  
  532. ******* Bitmap unpacker
  533. *    A0-> packed picture
  534. *    A1-> Destination screen
  535. *    D1.L Start in X
  536. *    D2.L Start in Y
  537. UAEc:    equ 0
  538. UDEc:    equ 4
  539. UITy:    equ 8
  540. UTy:    equ 10
  541. UTLine:    equ 12
  542. UNPlan:    equ 14
  543. UPile:    equ 16
  544. UnPack:    movem.l    a0-a6/d1-d7,-(sp)
  545.  
  546. * Jump over SCREEN DEFINITION
  547.     cmp.l    #SCCode,(a0)
  548.     bne.s    dec0
  549.     lea    PsLong(a0),a0
  550. * Is it a packed bitmap?
  551. dec0    cmp.l    #BMCode,(a0)
  552.     bne    NoPac
  553.  
  554. * Parameter preparation
  555.     lea    -UPile(sp),sp        * Space to work
  556.     lea    EcCurrent(a1),a2
  557.     move.l    a2,UAEc(sp)        * Bitmaps address
  558.         move.w     EcTLigne(a1),d7        * d7--> line size
  559.     move.w    EcNPlan(a1),d0        * How many bitplanes
  560.     cmp.w    PkNPlan(a0),d0
  561.     bne    IFonc
  562.     move.w    d0,UNPlan(sp)
  563.     move.w    Pktcar(a0),d6        * d6--> SY square
  564.  
  565.         tst.l     d1            * Screen address in X
  566.         bpl.s     dec1
  567.         move.w     Pkdx(a0),d1
  568. dec1:   tst.l     d2            * In Y
  569.         bpl.s     dec2
  570.         move.w     Pkdy(a0),d2
  571. dec2:   move.w    Pktx(a0),d0
  572.     add.w    d1,d0
  573.     cmp.w    d7,d0
  574.     bhi    IFonc
  575.     move.w    Pkty(a0),d0
  576.     mulu    d6,d0
  577.     add.w    d2,d0
  578.     cmp.w    EcTy(a1),d0
  579.     bhi    IFonc
  580.  
  581.     mulu    d7,d2            * Screen address
  582.     ext.l    d1    
  583.     add.l    d2,d1
  584.     move.l    d1,UDEc(sp)
  585.     
  586.     move.w    d6,d0            * Size of one line
  587.         mulu     d7,d0
  588.         move     d0,UTLine(sp)
  589.  
  590.         move.w     Pktx(a0),a3        * Size in X
  591.         subq.w    #1,a3
  592.         move.w     Pkty(a0),UITy(sp)    * in Y
  593.         lea     PkDatas1(a0),a4            * a4--> bytes table 1
  594.         move.l     a0,a5
  595.         move.l     a0,a6
  596.         add.l     PkDatas2(a0),a5         * a5--> bytes table 2
  597.         add.l     PkPoint2(a0),a6         * a6--> pointer table
  598.  
  599.         moveq     #7,d0            
  600.         moveq     #7,d1
  601.         move.b     (a5)+,d2
  602.         move.b     (a4)+,d3
  603.         btst     d1,(a6)
  604.         beq.s     prep
  605.         move.b     (a5)+,d2
  606. prep:   subq.w     #1,d1
  607.  
  608. * Unpack!
  609. dplan:  move.l     UAEc(sp),a2
  610.     addq.l    #4,UAEc(sp)
  611.     move.l    (a2),a2
  612.     add.l    UDEc(sp),a2
  613.         move.w     UITy(sp),UTy(sp)    * Y Heigth counter
  614. dligne: move.l     a2,a1
  615.         move.w     a3,d4
  616. dcarre: move.l     a1,a0
  617.         move.w     d6,d5           * Square height
  618. doctet1:subq.w     #1,d5
  619.         bmi.s     doct3
  620.         btst     d0,d2
  621.         beq.s     doct1
  622.         move.b     (a4)+,d3
  623. doct1:  move.b     d3,(a0)
  624.         add.w     d7,a0
  625.         dbra     d0,doctet1
  626.         moveq     #7,d0
  627.         btst     d1,(a6)
  628.         beq.s     doct2
  629.         move.b     (a5)+,d2
  630. doct2:  dbra     d1,doctet1
  631.         moveq     #7,d1
  632.         addq.l     #1,a6
  633.         bra.s     doctet1
  634. doct3:  addq.l    #1,a1               * Other squares?
  635.         dbra     d4,Dcarre
  636.         add.w     UTLine(sp),a2              * Other square line?
  637.         subq.w     #1,UTy(sp)
  638.         bne.s     Dligne
  639.         subq.w     #1,UNPlan(sp)
  640.         bne.s     Dplan
  641.         lea    UPile(sp),sp            * Restore the pile
  642. * Finished!
  643.     movem.l    (sp)+,a0-a6/d1-d7
  644.     rts
  645.  
  646.  
  647. ********************************************************
  648. *        DATA ZONE
  649.  
  650. *************** Packed screen header
  651.         RsReset
  652. PsCode        rs.l 1
  653. PsTx        rs.w 1
  654. PsTy        rs.w 1
  655. PsAWx        rs.w 1
  656. PsAWy        rs.w 1
  657. PsAWTx        rs.w 1
  658. PsAWTy        rs.w 1
  659. PsAVx        rs.w 1
  660. PsAVy        rs.w 1
  661. PsCon0        rs.w 1
  662. PsNbCol        rs.w 1
  663. PsNPlan        rs.w 1
  664. PsPal        rs.w 32
  665. PsLong        equ __Rs
  666. SCCode        equ $12031990
  667. *************** Packed picture header
  668.         RsReset
  669. Pkcode       rs.l 1
  670. Pkdx         rs.w 1
  671. Pkdy         rs.w 1
  672. Pktx         rs.w 1
  673. Pkty         rs.w 1
  674. Pktcar       rs.w 1
  675. Pknplan        rs.w 1
  676. PkDatas2     rs.l 1
  677. PkPoint2     rs.l 1
  678. PkLong      equ __Rs
  679. PkDatas1    equ __Rs
  680. BMCode        equ $06071963
  681.  
  682. ***********************************************************
  683. *         COMPACTOR TOKENS
  684. Tk:        dc.w     1,0
  685.         dc.b     $80,-1
  686.         dc.w     Pack2-Tk,1
  687.         dc.b     "!pac","k"+$80,"I0t0",-2
  688.         dc.w    Pack6-Tk,1
  689.         dc.b    $80,"I0t0,0,0,0,0",-1
  690.         dc.w     SPack2-Tk,1
  691.         dc.b     "!spac","k"+$80,"I0t0",-2
  692.         dc.w    SPack6-Tk,1
  693.         dc.b    $80,"I0t0,0,0,0,0",-1
  694.         dc.w    UPack1-Tk,1
  695.         dc.b    "!unpac","k"+$80,"I0",-2
  696.         dc.w     UPack2-Tk,1
  697.         dc.b    $80,"I0t0",-2
  698.         dc.w     UPack3-Tk,1
  699.         dc.b    $80,"I0,0,0",-1
  700.         dc.w     0
  701.  
  702. *************** Small data zone
  703. TSize:        dc.w 1,2,3,4,5,6,7,8,12,16,24,32,48,64,0
  704. PacAdr:        dc.l 0
  705.  
  706. *************** Definition banque de samples
  707. BkPac:        dc.b "Pac.Pic."
  708.  
  709. *************** Welcome message
  710. PacWel:        dc.b 27,"Y",48+9,"Picture compactor V 1.1",0
  711.  
  712. *************** ERROR MESSAGES
  713. PacErr:        dc.b "Not a packed bitmap",0
  714.         dc.b "Not a packed screen",0
  715.  
  716. ***************
  717.         dc.l    0
  718.  
  719.  
  720.